home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / CATEG.FOR < prev    next >
Text File  |  1988-02-08  |  5KB  |  195 lines
  1.       SUBROUTINE CATEG ( STRING, TYPE, FORM )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          CATEG            **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          FIND THE TYPE OF A STRING
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA   94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          TO CATEGORIZE A STRING AS EITHER A LOGICAL, INTEGER, FLOATING,
  23. C*          E-FLOATING, D-FLOATING, OR ALPHANUMERIC.
  24. C*          ALTHOUGH QUITE ACCURATE, IT IS NOT FOOL-PROOF.
  25. C*
  26. C*     INPUT ARGUMENTS :
  27. C*          STRING - THE STRING CONTAINING THE STRING TO CHECK
  28. C*
  29. C*     OUTPUT ARGUMENTS :
  30. C*          TYPE   - 'L', 'I', 'F', 'E', 'D', 'A'
  31. C*          FORM   - A VALID FORTRAN FORMAT FIELD FOR THIS STRING
  32. C*
  33. C*     INTERNAL WORK AREAS :
  34. C*          NONE
  35. C*
  36. C*     COMMON BLOCKS :
  37. C*          NONE
  38. C*
  39. C*     FILE REFERENCES :
  40. C*          NONE
  41. C*
  42. C*     DATA BASE ACCESS :
  43. C*          NONE
  44. C*
  45. C*     SUBPROGRAM REFERENCES :
  46. C*          BLANKS,  CAPS
  47. C*
  48. C*     ERROR PROCESSING :
  49. C*          NONE
  50. C*
  51. C*     TRANSPORTABILITY LIMITATIONS :
  52. C*          NON-STANDARD VARIABLE FIELD FORMAT STATEMENTS
  53. C*
  54. C*     ASSUMPTIONS AND RESTRICTIONS :
  55. C*          NONE
  56. C*
  57. C*     LANGUAGE AND COMPILER :
  58. C*          ANSI FORTRAN 77
  59. C*
  60. C*     VERSION AND DATE :
  61. C*          VERSION I.0      8-FEB-85
  62. C*
  63. C*     CHANGE HISTORY :
  64. C*           8-FEB-85    INITIAL VERSION
  65. C*
  66. C***********************************************************************
  67. C*
  68.       CHARACTER *(*) STRING, FORM
  69.       CHARACTER *1 TYPE, LET
  70. C
  71.       CALL BLANKS ( STRING, L )
  72.       CALL CAPS ( STRING )
  73. C
  74. C --- DEFAULT TYPE IS ALPHANUMERIC, DEFAULT FORMAT IS 'Ann'
  75. C
  76.       TYPE = 'A'
  77.       LF   = LEN ( STRING )
  78.       IFM  = 1
  79.       IF (LF .GT. 9) IFM = 2
  80.       IF (LF .GT. 99) IFM = 3
  81.       WRITE ( FORM, 900 ) LF
  82.       IS   = 1
  83.       MC   = 0
  84. C
  85. C --- CHECK FOR LOGICAL TYPE
  86. C
  87.       IF (STRING(IS:IS) .EQ. '.') THEN
  88.          IF ((STRING(IS:IS+2) .EQ. '.T.') .OR.
  89.      $       (STRING(IS:IS+2) .EQ. '.F.')) THEN
  90.             IF (L .EQ. 3) THEN
  91.                TYPE = 'L'
  92.                FORM = 'L3'
  93.             ENDIF
  94.             RETURN
  95.          ENDIF
  96.          IF (STRING(IS:IS+5) .EQ. '.TRUE.') THEN
  97.             IF (L .EQ. 6) THEN
  98.                TYPE = 'L'
  99.                FORM = 'L6'
  100.             ENDIF
  101.             RETURN
  102.          ENDIF
  103.          IF (STRING(IS:IS+6) .EQ. '.FALSE.') THEN
  104.             IF (L .EQ. 7) THEN
  105.                TYPE = 'L'
  106.                FORM = 'L7'
  107.             ENDIF
  108.             RETURN
  109.          ENDIF
  110.       ENDIF
  111. C
  112. C --- CHECK FOR NUMERIC
  113. C
  114.       IF ((STRING(IS:IS) .EQ. '+') .OR. (STRING(IS:IS) .EQ. '-'))
  115.      $  IS = IS + 1
  116. C
  117. C --- SIGN AND DIGITS ONLY... ITS AN INTEGER
  118. C
  119. 10    IF (IS .GT. L) THEN
  120.          TYPE = 'I'
  121.          IS   = IS - 1
  122.          IFM  = 1
  123.          IF (IS .GT. 9) IFM = 2
  124.          WRITE (FORM, 910) IS
  125.          RETURN
  126.       ENDIF
  127.       IF ((STRING(IS:IS) .LT. '0') .OR. (STRING(IS:IS) .GT. '9'))GOTO 20
  128.       IS = IS + 1
  129.       GO TO 10
  130. C
  131. C --- IN ORDER TO BE A NUMBER THE NEXT CHARACTER MUST BE '.', 'E', 'D'
  132. C
  133. 20    IF (STRING(IS:IS) .NE. '.') THEN
  134.          IF ((STRING(IS:IS) .EQ. 'E') .OR. (STRING(IS:IS) .EQ. 'D'))
  135.      $    GO TO 40
  136.          RETURN
  137.       ENDIF
  138.       IS = IS + 1
  139. C
  140. C --- 'INTEGER' '.' 'INTEGER' ONLY... IT'S FIXED POINT
  141. C
  142. 30    IF (IS .GT. L) THEN
  143.          TYPE = 'F'
  144.          IS   = IS - 1
  145.          IFM  = 1
  146.          IF (IS .GT. 9) IFM = 2
  147.          IFM1 = 1
  148.          IF (MC .GT. 9) IFM1 = 2
  149.          WRITE (FORM, 920) IS, MC
  150.          RETURN
  151.       ENDIF
  152.       IF ((STRING(IS:IS) .LT. '0') .OR. (STRING(IS:IS) .GT. '9'))GOTO 40
  153.       MC = MC + 1
  154.       IS = IS + 1
  155.       GO TO 30
  156. C
  157. C --- THE NEXT CHARACTER MUST BE AN EXPONENT TO BE FLOATING
  158. C
  159. 40    IF (STRING(IS:IS) .EQ. 'E') THEN
  160.          LET = 'E'
  161.       ELSE IF(STRING(IS:IS) .EQ. 'D') THEN
  162.          LET = 'D'
  163.       ELSE
  164.          RETURN
  165.       ENDIF
  166.       IS = IS + 1
  167.       IF ((STRING(IS:IS) .EQ. '-') .OR. (STRING(IS:IS) .EQ. '+'))
  168.      $  IS = IS + 1
  169. C
  170. C --- IF THE REST IS AN EXPONENT, ITS FLOATING POINT
  171. C
  172. 50    IF (IS .GT. L) THEN
  173.          IS = IS - 1
  174.          IFM = 1
  175.          IF (IS .GT. 9) IFM = 2
  176.          IFM1 = 1
  177.          IF (MC .GT. 9) IFM1 = 2
  178.          WRITE (FORM,930) LET,IS,MC
  179.          TYPE = LET
  180.          RETURN
  181.       ENDIF
  182.       IF ((STRING(IS:IS) .GE. '0') .AND. (STRING(IS:IS) .LE. '9')) THEN
  183.          IS = IS + 1
  184.          GO TO 50
  185.       ENDIF
  186.       RETURN
  187. 900   FORMAT ( 'A',I<IFM> )
  188. 910   FORMAT ( 'I',I<IFM> )
  189. 920   FORMAT ( 'F',I<IFM>,'.',I<IFM1> )
  190. 930   FORMAT ( A1,I<IFM>,'.',I<IFM1> )
  191.       END
  192. C
  193. C---END CATEG
  194. C
  195.